perm filename TOP.LSP[MRS,LSP] blob
sn#702141 filedate 1983-03-18 generic text, type T, neo UTF8
;;; mrs-version-file should be set up to point to a file which contains two
;;; fixnums. The first number is the version number of the MRS, and the second
;;; number is the number of modifications that have been made. Every time
;;; an MRS is made, the mod number will be incremented. To bootstrap the
;;; system, the file should contain 4 1".
(declare (special mrsversion))
#+franz
(defun mrs-top-level ()
(cond ((plist 'user-top-level)
(prog (home rcfile)
(princ "MRS Version ")
(princ mrsversion)
(princ " in ")
(princ (status version)) (terpri) (terpri)
(setq rcfile (parse-command-line)
home (getenv '|HOME|))
(cond (rcfile (or (and (probef rcfile)
(load rcfile))
(and (probef (concat home "/" rcfile))
(load (concat home "/" rcfile)))
(and (probef ".mrsrc")
(load ".mrsrc"))
(and (probef (concat home "/" ".mrsrc"))
(load (concat home "/" ".mrsrc"))))))
(setq user-top-level nil)
(setplist 'user-top-level nil)
(remob 'mrs-top-level)))))
#+franz
(defun parse-command-line ()
(prog (rcfile args arg file)
(setq progrm (stripdirectory (argv 0)))
(setq rcfile (concat "." progrm "rc"))
; (setq rcfile (concat ".mrsrc")) ;always look for .mrsrc
(setq args (1- (argv -1))
arg 0)
loop
(cond ((= arg args) (return rcfile))
(t (setq arg (1+ arg))))
(cond ((eq (argv arg) '-f)
(setq rcfile nil))
((eq (argv arg) '-r)
(load (argv (setq arg (1+ arg)))))
(t (princ (argv arg))
(princ " unknown switch, ignored.")
(terpri)))
(go loop)))
#+franz
(defun stripdirectory (file)
(let ((temp (explodec file)))
(do ((proc (memq '/ temp) (memq '/ temp)))
((null proc) (implode temp))
(setq temp (cdr proc)))))
#+franz
(defun read-version ()
(let* ((file (infile mrs-version-file))
(ver (read file)) (mod (read file)))
(close file)
(setq file (outfile mrs-version-file))
(princ ver file)
(princ " " file)
(princ (1+ mod) file)
(terpri file)
(close file)
(setq ver (implode (nconc (explodec ver) (ncons '|.|) (explodec mod))))
(setq mrsversion ver)))
#-franz
(defun read-version ()
(let* ((file (open mrs-version-file 'in))
(ver (read file)) (mod (read file)))
(close file)
(setq file (open mrs-version-file 'out))
(princ ver file)
(princ " " file)
(princ (1+ mod) file)
(terpri file)
(close file)
(setq ver (implode (nconc (explodec ver) (ncons '|.|) (explodec mod))))
(setq mrsversion ver)))
#+franz(setplist 'user-top-level '(t))
#+franz(setq user-top-level 'mrs-top-level)
(sstatus feature mrs)
(read-version)